perm filename MIXSCR.F4[SCR,MUS] blob sn#544853 filedate 1980-11-10 generic text, type T, neo UTF8
C***** MIXES AND LINKS FILES PUT OUT BY 'SCORE' *******
C***** ALL FILES MUST HAVE THE .SCR EXTENSION *****
C***** LOAD WITH SPRINT.FAI (DON'T WORRY ABOUT SOME UNDEF. GLOBALS.)
C***** MAYBE USE 'R LOADER'.  INCLUDE '/LLIB40.OLD[1,3]'.  OTHERWISE THERE
C	WILL BE READ ERRORS DUE TO BUGS IN CURRENT LIB40 3/77 *******

	COMMON /VV/KL,N1,N2,N3,J,K,L,M,P1,PX,A,B,C,D,IBL
	COMMON /LNK/ NK,NZ(20),IP /QQQ/QQQ(144) /RRR/RRR(144)
	DIMENSION Q(18)
	EQUIVALENCE (Q,QQQ)
	DATA IBL/'     '/
	TYPE 24
	NK=0
	LX=0
	ACCEPT 2,K,IP
	CALL LO2UP(K)
	CALL LO2UP(IP)
	IF(K.EQ.'L')LX=-1
200	TYPE 20
	ACCEPT 2,N1
	IF(N1.EQ.IBL)GO TO 200
	CALL LO2UP(N1)
201	TYPE 22
	ACCEPT 2,N2
	CALL LO2UP(N2)
COPEN	IF(N2.EQ.IBL.OR.N2.EQ.N1)GO TO 201
	IF(LX.EQ.0)GO TO 202
1000	TYPE 41
	ACCEPT 2,K
	IF(K.EQ.IBL)GO TO 202
	CALL LO2UP(K)
C TAKES UP TO 2+10 FILES.
	NK=NK+1
	NZ(NK)=K
	IF(NK.LT.20)GO TO 1000
	
202	TYPE 123
	ACCEPT 124,DELAY
2001	TYPE 23
	ACCEPT 2,N3
	CALL LO2UP(N3)
	IF(N3.NE.IBL.AND.N3.NE.N1.AND.N3.NE.N2)GO TO 2000
	TYPE 2002
	GO TO 2001
2002	FORMAT(' USE DIFFERENT NAME FOR OUTPUT.')
2000	CALL OPENIT(1,N3,'SCR',1)
	CALL OPENIT(21,N1,'SCR',0)
	CALL OPENIT(22,N2,'SCR',0)
C   CALL OPENIT(A,B,C,D) D=0=INPUT  D=1=OUTPUT
	TYPE 25
	IF(LX.EQ.0)GO TO 25
	CALL LINK
	GO TO 204
25	FORMAT(/' WORKING'/)
	DO 1 K=1,3
	READ(21,2)Q
	WRITE(1,2)Q
1	READ(22,2)Q
C READS FIRST 3 LINES
	
	CALL CHECK(N,QQQ,P1,21)
	CALL CHECK(M,RRR,PX,22)
	PX=PX+DELAY
CATCHES INSERTED LINES.
6	IF(PX.LT.P1)GO TO 5
	CALL RDWRT(N,P1,QQQ,21)
	IF(KL)10,6,6

5	CALL RDWRT(M,PX,RRR,22)
	PX=PX+DELAY
	IF(KL.EQ.0)GO TO 6

11	PX=10000
	GO TO 13
10	P1=10000
13	IF(P1.NE.10000.OR.M.NE.N)GO TO 6
12	WRITE(1,7)
204	END FILE 1
	TYPE 203,N3
	CALL EXIT
203	FORMAT(/' ******  MIX FILE NAME = ',A5,'.SCR',/
	1 ' ****** THIS FILE MAY NEED EDITING.')
2	FORMAT(18A5)
7	FORMAT(' FINISH;')
24	FORMAT(' MIXES OR LINKS SCORE LISTS.'/
	1' USES ".SCR" EXTENSIONS ONLY!!! '/
	1' BE SURE ALL HIGHER PARAMS PRINT EACH TIME.'
	1//' L = LINK, <CR> = MIX  '$)
41	FORMAT(' TYPE NEXT FILE NAME OR <CR>  '$)
20	FORMAT(' TYPE FILE 1 (WITHOUT EXT.)   '$)
22	FORMAT(/' TYPE FILE 2  '$)
23	FORMAT(/' TYPE OUTPUT NAME  '$)
123	FORMAT(' DELAY TIME = '$)
124	FORMAT(F)
	END

	SUBROUTINE CHECK(N,Z,P1,J)
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,IBL
	1 /QQQ/QQQ(144)
	DIMENSION AA(50),Z(144)
	DATA J1/7/,J2/12/,J3/21/
C  J1,J2,J3 ARE POINTERS TO POS. OF DOTS IN P1,P2
	KL=0
33	READ(J,30,END=100)Z         
	IF(Z(J1).NE.' ')GO TO 32
	IF(Z(J2).NE.'.')GO TO 32
	IF(Z(J3).EQ.'.')GO TO 31
CATCHES INSERTED LINES.
32	IF(Z(2).NE.'F')GO TO 300
	IF(Z(3).NE.'I')GO TO 300
	IF(Z(4).NE.'N')GO TO 300
	IF(Z(5).NE.'I')GO TO 300
	IF(Z(6).NE.'S')GO TO 300
	KL=-1
	N='FINIS'
300	CALL SHORT(Z)
	IF(KL)RETURN
	GO TO 33
100	PAUSE 'DIED IN SUBR CHECK'
31	REREAD 4,L,N,P1
30	FORMAT(144A1)
4	FORMAT(A1,A5,F)
44	FORMAT(A1,20A5)
	END

	SUBROUTINE SHORT(QQQ)
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P,PX,LL,K,A,B,IBL
	COMMON /LNK/ NK,NZ(20),IP
	DIMENSION QQQ(1)
	DO 1 K=144,1,-1
1	IF(QQQ(K).NE.' ')GO TO 2
2	IF(IP.NE.IBL)TYPE 44,(QQQ(LL),LL=1,K)
	IF(KL)RETURN
3	WRITE(1,44)(QQQ(LL),LL=1,K)
44	FORMAT(144A1)
	END

	SUBROUTINE RDWRT(I,P,Z,J)
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
	DIMENSION Z(144)
	KL=0
	DO 3 K=144,1,-1
3	IF(Z(K).NE.' ')GO TO 4
4	IF(J.NE.22)GO TO 40
	WRITE(1,41)(Z(N),N=1,6),P,(Z(N),N=16,K)
	GO TO 1
40	WRITE(1,44)(Z(N),N=1,K)
1	READ (J,44,END=100)Z
	DO 5 K=144,1,-1
5	IF(Z(K).NE.' ')GO TO 6
6 	WRITE(1,44)(Z(N),N=1,K)
 	IF(Z(1).NE.';')GO TO 1
	IF(Z(2).NE.'P')GO TO 1
	IF(Z(3).NE.'R')GO TO 1
	IF(Z(4).NE.'I')GO TO 1
	IF(Z(5).NE.'N')GO TO 1
	IF(Z(6).NE.'T')GO TO 1
2	CALL CHECK(I,Z,P,J)
	RETURN
44	FORMAT(144A1)
41	FORMAT(6A1,F9.3,137A1)
100	PAUSE 'DIED IN SUBR RDWRT - INPUT FILE FORMAT INCORRECT'
	END

	SUBROUTINE LINK
	COMMON /VV/KL,N1,N2,N3,JJ,KK,L,M,P1,PX,LL,K,IBL
	COMMON /LNK/ NK,NZ(20),IP /QQQ/QQQ(144)
44	FORMAT(144A1)
	KL=0
	JJ=0
	J=21
1	READ(J,44)QQQ
32	IF(QQQ(2).NE.'F')GO TO 4
	IF(QQQ(3).NE.'I')GO TO 4
	IF(QQQ(4).NE.'N')GO TO 4
	IF(QQQ(5).NE.'I')GO TO 4
	IF(QQQ(6).NE.'S')GO TO 4
	GO TO 2
4	CALL SHORT(QQQ)
	IF(JJ.GT.NK)RETURN
	GO TO 1
2	IF(J.NE.21)GO TO 3
	J=J+1
	GO TO 1
3	JJ=JJ+1
	IF(JJ.GT.NK)GO TO 4
	CALL OPENIT(22,NZ(JJ),'SCR',0)
	GO TO 1
	END

	SUBROUTINE LO2UP(J)
C CONVERTS ALL LOWER CASE IN WORD J TO UPPER CASE.
	J=J.AND..NOT.((J/2).AND."201004020100)
	END